home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / edit / ae_14.zip / AE4.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-12  |  29KB  |  708 lines
  1. unit AE4 ;
  2.  
  3. {$B-}
  4. {$I-}
  5. {$S+}
  6. {$V-}
  7.  
  8. interface
  9.  
  10. uses Crt,Dos,Printer,AE0,AE1,AE2,AE3 ;
  11.  
  12. function CopyBlock : boolean ;
  13. procedure DeleteBlock ;
  14. procedure InsertBlock ;
  15. procedure PrintBlock (Buffer:WsBufptr ; BlockStart,BlockEnd:word ) ;
  16. procedure InsertFile (Filename:PathStr; P:Position) ;
  17. procedure LoadFile (Filename:PathStr) ;
  18. function GetFileFromList (Name:PathStr) : PathStr ;
  19. procedure InsertSpaces (var P:Position ; NrOfSpaces:word) ;
  20. procedure InsertCRLF (var P:Position) ;
  21. procedure RedrawScreen ;
  22. procedure AlterSetup ;
  23.  
  24. implementation
  25.  
  26. {-----------------------------------------------------------------------------}
  27. { Copies the block in the current workspace to the paste buffer. If no block  }
  28. { is indicated or if the block is too large for the paste buffer, an error    }
  29. { message is given, and the function result will be False.                    }
  30. {-----------------------------------------------------------------------------}
  31.  
  32. function CopyBlock : boolean ;
  33.  
  34. var Result : boolean ;
  35.  
  36. begin
  37. Result := False ;
  38. with Workspace[CurrentWsnr] do
  39.      begin
  40.      if (Mark > 0)
  41.         then begin
  42.              if Mark < CurPos.Index
  43.                 then begin
  44.                      if (CurPos.Index - Mark) > PasteBufSize
  45.                         then ErrorMessage (4)
  46.                         else begin
  47.                              PasteBufferSize := CurPos.Index - Mark ;
  48.                              Move (Buffer^[Mark],PasteBuffer^[1],
  49.                                    PasteBufferSize) ;
  50.                              Result := True ;
  51.                              end ;
  52.                      end
  53.                 else begin
  54.                      if (Mark - CurPos.Index) > PasteBufSize
  55.                         then ErrorMessage (4)
  56.                         else begin
  57.                              PasteBufferSize := Mark - CurPos.Index ;
  58.                              Move (Buffer^[CurPos.Index],PasteBuffer^[1],
  59.                                    PasteBufferSize) ;
  60.                              Result := True ;
  61.                              end ;
  62.                      end ;
  63.              end
  64.         else ErrorMessage (5) ;
  65.      end ; { of with }
  66. CopyBlock := Result ;
  67. end ;
  68.  
  69. {-----------------------------------------------------------------------------}
  70. { Deletes the block from the current workspace.                               }
  71. {-----------------------------------------------------------------------------}
  72.  
  73. procedure DeleteBlock ;
  74.  
  75. var OldCurPosIndex : word ;
  76.  
  77. begin
  78. with Workspace[CurrentWsnr] do
  79.      begin
  80.      if Mark > 0
  81.         then begin
  82.              if Mark < CurPos.Index
  83.                 then begin
  84.                      { if Mark is before CurPos: exchange positions }
  85.                      OldCurPosIndex := CurPos.Index ;
  86.                      SkipUp (CurPos,OldCurPosIndex-Mark) ;
  87.                      Mark := OldCurPosIndex ;
  88.                      end ;
  89.              Shrink (CurPos.Index,Mark-CurPos.Index) ;
  90.              Mark := 0 ;
  91.              end ;
  92.      end ;
  93. end ;
  94.  
  95. {-----------------------------------------------------------------------------}
  96. { Inserts the contents of the paste buffer into the current workspace at      }
  97. { position CurPos. If successful, Mark will be pointing to the end of the     }
  98. { inserted block, and CurPos to the start.                                    }
  99. {-----------------------------------------------------------------------------}
  100.  
  101. procedure InsertBlock ;
  102.  
  103. begin
  104. with Workspace[CurrentWsnr] do
  105.      begin
  106.      if Grow (CurPos.Index,PasteBufferSize)
  107.         then Move (PasteBuffer^[1],Buffer^[CurPos.Index],PasteBufferSize) ;
  108.      end ; { of with }
  109. end ;
  110.  
  111. {-----------------------------------------------------------------------------}
  112. { Dumps a block (indicated by BlockStart and BlockEnd) to the printer.        }
  113. { If enabled by Setup, form feeds, left and top margins and page numbers      }
  114. { are added.                                                                  }
  115. {-----------------------------------------------------------------------------}
  116.  
  117. procedure PrintBlock (Buffer:WsBufptr ; BlockStart,BlockEnd:word ) ;
  118.  
  119. var Counter,IndexCounter,LineCounter,PageCounter,LinesPerPage : word ;
  120.     DummyKey : word ;
  121.     AbortPrint : boolean ;
  122.  
  123. begin
  124. LineCounter := 1 ;
  125. PageCounter := 1 ;
  126. { LinesPerPagecontains number of text lines on a page }
  127. LinesPerPage := Config.Setup.PageLength ;
  128. if Config.Setup.PrintPagenrs then Dec (LinesPerPage,2) ;
  129. Message ('Printing. Press any key to interrupt') ;
  130. AbortPrint := False ;
  131. IndexCounter := BlockStart ;
  132. { write left margin of first line }
  133. Write (Lst,'':Config.Setup.LeftMargin) ;
  134. repeat if LineCounter = 1
  135.           then begin
  136.                { skip top margin }
  137.                for Counter := 1 to Config.Setup.TopMargin do
  138.                    Writeln (Lst) ;
  139.                LineCounter := Config.Setup.TopMargin + 1 ;
  140.                Write (Lst,'':Config.Setup.LeftMargin) ;
  141.                end ;
  142.        Write (Lst,Buffer^[IndexCounter]) ;
  143.        if Buffer^[IndexCounter] = CR
  144.           then begin
  145.                Inc (LineCounter) ;
  146.                { write left margin }
  147.                Write (Lst,'':Config.Setup.LeftMargin) ;
  148.                end ;
  149.        if ((LineCounter > LinesPerPage) or (Buffer^[IndexCounter] = FF)) and
  150.           (Config.Setup.PageLength > 0)
  151.           then begin
  152.                { end current page and start new one }
  153.                if Config.Setup.PrintPagenrs
  154.                   then begin
  155.                        Writeln (Lst) ; Writeln (Lst) ;
  156.                        Write (Lst,'Pag ',PageCounter:2) ;
  157.                        end ;
  158.                Write (Lst,FF) ;
  159.                LineCounter := 1 ;
  160.                Inc (PageCounter) ;
  161.                { write left margin }
  162.                Write (Lst,'':Config.Setup.LeftMargin) ;
  163.                end ;
  164.        Inc (IndexCounter) ;
  165.        CheckDiskError ;
  166.        AbortPrint := (DiskError <> 0) ;
  167.        if KeyPressed
  168.           then begin
  169.                ClearKeyBuffer ;
  170.                { ask for confirmation }
  171.                AbortPrint := Answer ('Abort printing?') ;
  172.                if not AbortPrint
  173.                   then Message ('Printing. Press any key to interrupt') ;
  174.                end ;
  175. until (IndexCounter > BlockEnd) or AbortPrint ;
  176. if (Config.Setup.PrintPagenrs) and (not KeyPressed)
  177.    then begin
  178.         { end last page: move to end of page and print page number }
  179.         for Counter := LineCounter to (LinesPerPage+1) do
  180.             Writeln (Lst) ;
  181.         Write (Lst,'Pag ',PageCounter:2) ;
  182.         Write (Lst,FF) ;
  183.         CheckDiskError ;
  184.         end ;
  185. if AbortPrint
  186.    then Message ('Printing aborted')
  187.    else Message ('Printing completed') ;
  188. end ;
  189.  
  190. {-----------------------------------------------------------------------------}
  191. { Inserts the file <Filename> into the current workspace at position P.       }
  192. {-----------------------------------------------------------------------------}
  193.  
  194. procedure InsertFile (Filename:PathStr ; P:Position) ;
  195.  
  196. var F : file ;
  197.     Size,BytesToRead,AvailableSpace : longint ;
  198.     Counter : word ;
  199.  
  200. begin
  201. Assign (F,Filename) ;
  202. Reset (F,1) ;
  203. CheckDiskError ;
  204. if (DiskError = 0)
  205.    then begin
  206.         Size := FileSize (F) ;
  207.         with Workspace[CurrentWsnr] do
  208.              begin
  209.              BytesToRead := Size ;
  210.              AvailableSpace := WsBufSize - BufferSize ;
  211.              if BytesToRead > AvailableSpace
  212.                 then BytesToRead := AvailableSpace ;
  213.              if Grow (P.Index,BytesToRead)
  214.                 then begin
  215.                      { double reset: first to measure file size (record }
  216.                      { size 1), second to read file }
  217.                      Reset (F,BytesToRead) ;
  218.                      Message ('Reading file '+Filename) ;
  219.                      BlockRead (F,Buffer^[P.Index],1) ;
  220.                      CheckDiskError ;
  221.                      Mark := P.Index + BytesToRead ;
  222.                      { check for EndOfFile char }
  223.                      Counter := 0 ;
  224.                      while (Buffer^[